          PH.ARGS DRPT,BRCHS,BR,PLINES,DET,EXCL.NS,PLBRK,NEG.ONH,PRT.PRC,WRITER
** Version# 19.0003[19] - 03/04/2014 - 03:21pm - TSMITH - eclipse
*** V19.0003 Change - Custom Coding . - 03/04/2014 - TSMITH - eclipse
** Copied from CBP POE.PHR.BO.GPS Version# 19.0002 - 10/29/2013 - 10:42am - TSMITH - eclipse
*** V19.0002 Change - Custom Coding . - 10/29/2013 - TSMITH - eclipse
** Copied from BP POE.PHR.BO Version# 19 - 02/15/2011 - 04:17pm - BABS - main
*-------------------------------------------------------------------------*
*** Subroutine:  POE.PHR.BO
*-------------------------------------------------------------------------*
*** This creates the Product Backorder Report.
*-------------------------------------------------------------------------*
*** Parameters:
***       DRPT     -
***       BRCHS    - Branch(es)                                       [IN]
***       BR       - Literal response to the Branch prompt.           [IN]
***       PLINES   - Price Lines                                      (IN)
***       DET      - Overcommits or All                               [IN]
***       EXCL.NS  - Exclude Non Stock Items                          [IN]
***       PLBRK    - Break on Price Line Yes/No/Page                  [IN]
***       NEG.ONH  - Include Negative On-Hand                         [IN]
***       PRT.PRC  - Print selling price
*-------------------------------------------------------------------------*
*** Common Variables: DRPT
*-------------------------------------------------------------------------*

          EQU ONHANDS       TO PRDD.BR(1)
          EQU PENDING.ID    TO PRDD.BR(2)
          EQU STOCK.QTY     TO PRDD.BR(3)
          EQU LOCS          TO PRDD.BR(8)
          TB = CHAR(44)
          BR = CHAR(12)

          AS.OF.DT   = OCONV(DATE(),'D4/')
          SHIP.CUTOFF= DATE() + 365
          TROUBLE.ONLY = (DET = 'Overcommits as of Today')
          DET          = (DET[1,1]='A')

          BRS = BR

          BR.CT = DCOUNT(BRCHS,VM)
          BEGIN CASE
          CASE PLBRK = 'Y'
             PLBRK   =  1
          CASE PLBRK = 'P'
             PLBRK   =  2
          CASE OTHERWISE
             PLBRK   =  0
          END CASE
          SAVE.PL = '*'
*-------------------------------------------------------------------------*
          WRITE 'Selecting...' ON PHSTFILE,PID$
          GOSUB SEL.IDS

          WRITE 'Spooling...' ON PHSTFILE,PID$
*-------------------------------------------------------------------------*
          HDG = 'Product Backorder Report  '
          HDG := '  - NS : ':EXCL.NS
          IF NOT(DET) THEN
             IF TROUBLE.ONLY THEN
                HDG := '    - Overcommits Today'
             END ELSE
                HDG := '    - Overcommits Only '
             END
          END
          HDG = HDG"L#70":'Page :^###'
          BRANCH.ALLOW = 73
          IF LEN(BRS) > BRANCH.ALLOW THEN BRS = BRS[1,BRANCH.ALLOW]:'...'
          HDG<1,2> = 'Branches : ':BRS
          HDG<1,3> = 'Desc......':TB:'Buy Line':TB:'Br':TB:'OH':TB:'Prod ID':TB:'Order#':TB:'Customer':TB:'Ship Date':TB:'Qty':TB:'UM':TB:'Type':TB:'Avail':TB:'UM':TB
          *HDG<1,3> = 'Order#...... Customer/Vendor.................... Shipdate  Qty....... Typ  Avail......'
          IF PRT.PRC THEN
             HDG<1,3> := '  Price........':TB:'Writer....'
          END ELSE
             HDG<1,3> := '  Part#........':TB:'Writer....'
          END
          WDTH = LEN(HDG<1,3>)

          TITLE = 'Product Backorder Report as of ':AS.OF.DT
          PRINTER.ON WDTH,TITLE,DOC.ID,HDG,RPT.DFLT=DRPT
          WRITER   = LED(73)<1,GEN>
          LOOP
          IF (WRITER#'') AND (WRITER NE LED(73)<1,GEN>) THEN
          GOTO SKIPID
          END
             READNEXT PN ELSE EXIT
             GOSUB PRT.ONE
SKIPID:    REPEAT
          IF PLBRK THEN PLBRK = 1; GOSUB PRT.BRK
          PRINTER.OFF DOC.ID

          UT.PH.CLEANUP

          SEND.MESSAGE 'Phantom',USER.ID,TITLE:' is Complete'

          STOP
*-------------------------------------------------------------------------*
PRT.ONE:  MATREAD PRD FROM PRDFILE,PN ELSE MAT PRD = ''
          IF PRD(3)=3 OR PRD(3)=6             THEN RETURN
          IF PRD(3)=2 AND EXCL.NS[1,1]='E'    THEN RETURN
          IF PRD(3)#2 AND EXCL.NS[1,1]='O'    THEN RETURN
          IF PRD(53)#''                       THEN RETURN
          FOR BRN = 1 TO BR.CT
             BR = BRCHS<1,BRN>
             GET.PIL PIL,BR,PN,SHIP.CUTOFF
             GOSUB GET.COMMITTED
             BEGIN CASE
             CASE TROUBLE.ONLY
                * Trouble orders are those whereby there is not enough
                * currently on-hand to cover the order regardless of the
                * PIL
                IF COMMITTED THEN
                   GOSUB PRT.DET
                END
             CASE OTHERWISE
                IF PIL < 0 THEN GOSUB PRT.DET
             END CASE
          NEXT BRN

          RETURN
*-------------------------------------------------------------------------*
PRT.DET:  *
          PLINE = PRD(9)
          IF PLBRK AND SAVE.PL#PLINE THEN
             IF SAVE.PL # '*' THEN GOSUB PRT.BRK
             SAVE.PL = PLINE
          END
          PRDD.BR.GET BR,PN
          MATREAD PLNE FROM PLNEFILE,PRD(9) ELSE MAT PLNE = ''
          DFLT.PER.GET 'I',PER,UM
          GET.ONHAND ONHANDS,LOCS,STK.OH,TAG.OH,SIP.OH,TIP.OH,OTH.OH
          QOH    = (STK.OH + SIP.OH) / PER

          * If NEG.ONH is 'No' and item has a negative on-hand and no
          * committments then don't include the item on the report.
          IF NOT(NEG.ONH) THEN
             IF QOH < 0 AND COMMITTED = 0 THEN
                RETURN
             END
          END
          * If we're looking for Overcommited for Today, Quantity on Hand
          * needs to be less then our total outgoing(committed).
          IF TROUBLE.ONLY AND (COMMITTED + QOH) >= 0 THEN
             RETURN
          END

          *GOSUB PRT.PROD
          LOC.CT = DCOUNT(PENDING.ID,VM)
          AVAIL  = QOH
          FOR J = 1 TO LOC.CT
             LOC = PENDING.ID<1,J>
             QTY = STOCK.QTY<1,J> / PER
             IF TROUBLE.ONLY THEN
                * Only include outbound quantities
                IF QTY > 0 THEN QTY = 0
             END

             IF QTY THEN
                AVAIL= AVAIL + QTY
                IF DET OR AVAIL < 0 THEN
                   TYPE = FIELD(LOC,'~',6)
                   OID  = FIELD(LOC,'~',3)
                   LDID = FIELD(LOC,'~',4) + 0
                   MATREAD LED FROM LEDFILE,OID ELSE MAT LED = ''
                   GID  = FIELD(LOC,'~',5)
                   LOCATE GID IN LED(12)<1> SETTING GEN ELSE GEN = 1
                   SHIPDATE = LED(9)<1,GEN>
                   SHIPTO   = LED(5)<1,GEN>
                   WRITER   = LED(73)<1,GEN>
                   READV CUSNAME FROM CUSFILE,SHIPTO,1 ELSE CUSNAME = 'UNKNOWN'
                   GOSUB PRT.PROD
                   GOSUB PRT.LINE
                END
             END
          NEXT J

          RETURN
*-------------------------------------------------------------------------*
PRT.BRK:  *
          PRINT '' 'L#40' : '***'
*          IF PLBRK > 1 THEN PRINT CHAR(12) ELSE PRINT;PRINT
          *PRINT
          RETURN
*-------------------------------------------------------------------------*
PRT.PROD: *PRINT
          PRINT '*** ':PRD(1)<1,1>         "L#35 ":TB:
          PRINT PLINE                      "L#18 ":TB:
          PRINT BR                  "L#5":TB:
          PRINT QOH                        "R#10":UM "L#2":TB:
          PRINT PN                 "L#13":TB:
          RETURN
*-------------------------------------------------------------------------*
PRT.LINE: PRINT OID                        "L#12 ":TB:
          PRINT CUSNAME                    "L#35 ":TB:
          PRINT OCONV(SHIPDATE,"D2/")      "L#8":TB:
          PRINT QTY                        "R#10":TB:
          PRINT UM                         "L#2":TB:
          PRINT TYPE                       "R#4":TB:
          PRINT AVAIL                      "R#11":TB:
          PRINT UM                         "L#2  ":TB:
          IF PRT.PRC THEN
             LD.GET LDID
             SELL.PRICE = ICONV(OCONV(LD(8)<1,GEN>,'MR9'),'MR2')
             PRINT OCONV(SELL.PRICE,'MR2')'R2#13  ':TB:
             PRINT WRITER                  "L#11"
          END ELSE
             PRINT SPACE(13):TB:
             PRINT WRITER                  "L#11"
          END
          RETURN
*-------------------------------------------------------------------------*
SEL.IDS:

          IF PLINES # '' THEN
             IDS = ''
             CT = DCOUNT(PLINES,VM)
             FOR J = 1 TO CT
             PLINE = PLINES<1,J>
             GET.LINE.IDS ,ID2,PLINE
             CONVERT VM TO AM IN ID2
             IF ID2 THEN IDS = INSERT(IDS,-1;ID2)
             NEXT J
             SELECT IDS
             END

          EXEC = "SSELECT PRODUCT BY LINE BY SEQ"
          EXECUTE EXEC PASSLIST CAPTURING MSG

          RETURN
*-------------------------------------------------------------------------*
GET.COMMITTED: * Return outbound committments within the plenty date
          PRDD.BR.GET BR,PN
          DFLT.PER.GET 'I',PER,UM

          COMMITTED = 0

          COM.CT = DCOUNT(PENDING.ID,VM)
          CUTOFF = DATE.NEXT.REC(PN,BR); * Plenty date
          FOR J = 1 TO COM.CT
             COM.ID = PENDING.ID<1,J>
             QTY    = STOCK.QTY<1,J> / PER
             OID    = FIELD(COM.ID,'~',3)
             TYP    = FIELD(COM.ID,'~',6)
             TDT    = FIELD(COM.ID,'~',2)
             IF QTY < 0 THEN
                IF INDEX(STK.TYPES.AVL$,TYP[1,1],1) AND TDT <= CUTOFF THEN
                   COMMITTED += QTY
                END
             END
          NEXT J

          RETURN
*-------------------------------------------------------------------------*
!TSMITH~03/04/14~15:21
